home *** CD-ROM | disk | FTP | other *** search
- {*******************************************************}
- { }
- { xTool - Component Collection }
- { }
- { Copyright (c) 1995 Fabula Software, Stefan Bother }
- { stefc@fabula.com or 100023,275 on CIS }
- { }
- {*******************************************************}
- unit xRtfClipBrd;
- { give access to RTF clipboard format }
-
- interface
-
- uses
- Windows, Classes, ClipBrd;
-
- var
- CF_RTF: Word; { registered under the Text "Rich Text Format" }
-
- type
- TxRTFClipboard = class(TClipboard)
- private
- function GetAsRTF: String;
- procedure SetAsRTF(const Value: String);
- protected
- procedure SetBuffer(Format: Word; var Buffer; Size: Integer);
- public
- property AsRTF: String read GetAsRTF write SetAsRTF;
- end;
-
- { converts from and to RTF TStrings, used in TRichEdit for example }
- procedure strToRtf(const S: String; aRTF: TStrings);
- function RtfToStr(aRTF: TStrings): String;
-
- { use this function for access the new clipboard class }
- function RTFClipboard: TxRTFClipboard;
-
- implementation
-
- uses
- SysUtils;
-
- { helper stuff }
-
- procedure strToRtf(const S: String; aRTF: TStrings);
- var
- aMem : TMemoryStream;
- begin
- aMem:=TMemoryStream.Create;
- try
- aMem.Write(Pointer(S)^, Length(S));
- aMem.Position:=0;
- aRtf.LoadFromStream(aMem);
- finally
- aMem.Free;
- end;
- end;
-
- function RtfToStr(aRTF: TStrings): String;
- var
- aMem : TMemoryStream;
- begin
- aMem:=TMemoryStream.Create;
- try
- aRTF.SaveToStream(aMem);
- Result:= StrPas(PChar(aMem.Memory));
- finally
- aMem.Free;
- end;
- end;
-
-
- { TxRTFClipboard }
-
- function TxRTFClipboard.GetAsRTF: string;
- var
- Data: THandle;
- begin
- Open;
- Data := GetClipboardData(CF_RTF);
- try
- if Data <> 0 then
- Result := PChar(GlobalLock(Data)) else
- Result := '';
- finally
- if Data <> 0 then GlobalUnlock(Data);
- Close;
- end;
- end;
-
- { SetBuffer not protected ???? }
- procedure TxRTFClipboard.SetBuffer(Format: Word; var Buffer; Size: Integer);
- var
- Data: THandle;
- DataPtr: Pointer;
- begin
- Open;
- try
- Data := GlobalAlloc(GMEM_MOVEABLE, Size);
- try
- DataPtr := GlobalLock(Data);
- try
- Move(Buffer, DataPtr^, Size);
- { Adding; not protected why ???? }
- SetClipboardData(Format, Data);
- finally
- GlobalUnlock(Data);
- end;
- except
- GlobalFree(Data);
- raise;
- end;
- finally
- Close;
- end;
- end;
-
- procedure TxRTFClipboard.SetAsRTF(const Value: string);
- begin
- SetBuffer(CF_RTF, PChar(Value)^, Length(Value) + 1);
- end;
-
- { Initialization of the new cliboard object }
-
- var
- FClipboard: TxRTFClipboard;
-
- function RTFClipboard: TxRTFClipboard;
- begin
- if FClipboard = nil then
- FClipboard := TxRTFClipboard.Create;
- Result := FClipboard;
- end;
-
- initialization
- FClipboard := nil;
- CF_RTF := RegisterClipboardFormat('Rich Text Format');
- finalization
- FClipboard.Free;
- end.
-
-